home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE02 / TPACK / TPACK.ZIP / SPLASH.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-06-02  |  6.1 KB  |  213 lines
  1. {------------------------------------------------------------------------------}
  2. {UNREGISTERED VERSION (6/1/95) PLEASE REDISTRIBUTE IN tPACK.ZIP!
  3.  This revision does not contain everything, nor are the exciting
  4.  DataSetReporter and ExtendedMenu[Item] components included.
  5.  Use SWREG#5906 to receive these, icons and a help file for $130.
  6.  You must register when using this code in a business application!
  7.  You'll receive a license to use this code in up to 50 copies of
  8.  any app you write. In turn you will get responsive e-mail
  9.  tech support and enhancements till I run out of registrations
  10.  or suggestions. Meanwhile.. enjoy the code. Bye! I'll make more.
  11.  {(C)'1995 Michael/Ax-Systems, 71560,1754@Compuserve.com}
  12. {------------------------------------------------------------------------------}
  13.  
  14. unit Splash;
  15.  
  16. interface
  17.  
  18. uses
  19.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  20.   Forms, Dialogs, StdCtrls, ExtCtrls
  21. , UserInfo, MiscComp;
  22.  
  23.  
  24. type
  25.   TSplashScreenForm = class(TDemoForm)
  26.     Panel1: TPanel;
  27.     Bevel1: TBevel;
  28.       {bevels are really weird! try doing anything with the image and you'll see what
  29.       i mean. that when opening/changing the dfm file with the editor can make a difference}
  30.     Label1: TLabel;
  31.     Label2: TLabel;
  32.     Image1: TImage;
  33.     procedure FormDeactivate(Sender: TObject);
  34.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  35.     procedure FormClick(Sender: TObject);
  36.     procedure Image1Click(Sender: TObject);
  37.   private
  38.     { Private declarations }
  39.     fTimer: TTimer;
  40.     fOnDeactivating:TNotifyEvent;
  41.     procedure TimerOff(Sender: TObject);
  42.   public
  43.     { Public declarations }
  44.     procedure ShowFor(PauseTime,FloatTime:Longint);
  45.     property OnDeactivating:TNotifyEvent read fOnDeactivating write fOnDeactivating;
  46.   end;
  47.  
  48.  TSplashScreen = class(TDialogShell) {see userinfo.pas for details}
  49.  private
  50.    fPauseTime: Longint;
  51.    fFloatTime: Longint;
  52.    fOnExecute:TNotifyEvent;
  53.    fOnDeactivating:TNotifyEvent;
  54.  protected
  55.    function GetTest:Boolean; override;
  56.  public
  57.    constructor Create(aOwner:TComponent); override;
  58.    procedure Execute; override;
  59.  published
  60.    property PauseTime:LongInt read fPauseTime write fPauseTime default 1000;
  61.    property FloatTime:LongInt read fFloatTime write fFloatTime default 200;
  62.    property OnDeactivating:TNotifyEvent read fOnDeactivating write fOnDeactivating;
  63.    end;
  64.  
  65. implementation
  66.  
  67. {$R *.DFM}
  68.  
  69. Type
  70.   TSplashFlag=(splInitialized,splInDCL);
  71.   TSplashFlags= set of TSplashFlag;
  72. Const
  73.   SplashFlags:TSplashFlags=[];         {1byte}
  74.   SplashScreen:TSplashScreenForm=nil;  {4bytes}
  75.  
  76. { This will make the form disappear, and get freed, when ANY other form or window pops up.}
  77.  
  78. procedure TSplashScreenForm.ShowFor(PauseTime,FloatTime:Longint);
  79. begin
  80.   Show;                        {bring up the form}
  81.   Update;                       {the display}
  82.   if PauseTime>0 then begin
  83.     fTimer:=TTimer.Create(self); {make a timer}
  84.     with fTimer do try
  85.       Enabled:=False;            {begin setting it}
  86.       Interval:=PauseTime;         {set duration and event}
  87.       OnTimer:=TimerOff;
  88.       Enabled:=True;             {start the time}
  89.       while Enabled do
  90.         Application.ProcessMessages;     {AND WAIT RIGHT HERE TILL THE PAUSE TIME IS UP}
  91.     finally
  92.       fTimer.Free;
  93.       fTimer:=nil;
  94.       end;
  95.     end;
  96.   if FloatTime>0 then begin
  97.     fTimer:=TTimer.Create(self); {make a timer}
  98.     with fTimer do begin
  99.       Enabled:=False;            {begin setting it}
  100.       Interval:=FloatTime;         {set duration and event}
  101.       OnTimer:=TimerOff;
  102.       Enabled:=True;             {start the time}
  103.       end;                       {DO NOT WAIT HERE BUT GO ON WITH OTHER INITS.}
  104.     end;
  105. end;
  106.  
  107. procedure TSplashScreenForm.TimerOff(Sender: TObject);
  108. begin
  109.   fTimer.Enabled:=False;
  110. end;
  111.  
  112. procedure TSplashScreenForm.FormDeactivate(Sender: TObject);
  113. begin
  114.   Close;
  115. end;
  116.  
  117. procedure TSplashScreenForm.FormClose(Sender: TObject;
  118.   var Action: TCloseAction);
  119. begin
  120.   try
  121.     if assigned(fOnDeactivating) then
  122.       fOnDeactivating(Self); {can turn off the timer!}
  123.     if fTimer<>nil then      {normally we wait till the float elapses}
  124.       try
  125.         while fTimer.Enabled do
  126.           Application.ProcessMessages;
  127.       finally
  128.         fTimer.Free;
  129.         fTimer:=nil;
  130.         end;
  131.   finally
  132.     Action:=caFree;
  133.     {SplashScreen.Free;  {release the memory}
  134.     SplashScreen:= nil; {zero out the pointer}
  135.     end;
  136. end;
  137.  
  138. {}
  139.  
  140. constructor TSplashScreen.Create(aOwner:TComponent);
  141. begin
  142.   inherited create(aOwner);
  143.   fPauseTime:=0;
  144.   fFloatTime:=200;
  145.   if (aOwner=nil) then
  146.     Execute;
  147. end;
  148.  
  149. procedure TSplashScreen.Execute; {make the splash-screen form. it will free/nil itself.}
  150. begin
  151.   if SplashScreen=nil then begin
  152.     SplashScreen:= TSplashScreenForm.Create(nil);
  153.     With SplashScreen do begin
  154.       OnDeActivate:=FormDeactivate;
  155.       OnDeactivating:=Self.OnDeactivating;
  156.       if splInDCL in SplashFlags then
  157.         SplashScreen.Show {do not use timers while in a library}
  158.       else
  159.         SplashScreen.ShowFor(fPauseTime,fFloatTime);
  160.       end;
  161.     end; {else already active}
  162. end;
  163.  
  164.  
  165. function TSplashScreen.GetTest:Boolean;
  166. begin
  167.   Result:= Assigned(SplashScreen);
  168. end;
  169.  
  170. {}
  171.  
  172. function InDcl:Boolean;
  173. var
  174.  i:integer;
  175.  p:pchar;
  176. begin
  177.   Result:=False;
  178.   getmem(p,80);
  179.   try
  180.     i:=GetModuleFileName(hInstance,p,80);
  181.     Result:=StrPos(StrUpper(p),'.DCL')<>nil;
  182.   finally
  183.     FreeMem(p,80);
  184.     end;
  185. end;
  186.  
  187. procedure Initialize;
  188. begin
  189.   SplashFlags:=SplashFlags+[splInitialized];
  190.   if InDcl then
  191.     SplashFlags:=SplashFlags+[splInDCL] {store the flag so we can suppress delay during design}
  192.   else
  193.     with TSplashScreen.Create(nil) do   {tada!; make/free the _component_ that makes the form}
  194.       Free;
  195. end;
  196.  
  197. { Here's the call to automatically show the SplashScreen when this unit is initialized!}
  198. procedure TSplashScreenForm.FormClick(Sender: TObject);
  199. begin
  200.   Close;
  201. end;
  202.  
  203. procedure TSplashScreenForm.Image1Click(Sender: TObject);
  204. begin
  205.   tForm(Owner).Close;
  206. end;
  207.  
  208. initialization
  209.   if not (splInitialized in SplashFlags) then
  210.     Initialize;
  211. end.
  212.  
  213.